Pensieve Header: Comparing the Alexander blob rules with the I2D rules, with conventions following the Chicago ax+b handout of http://www.math.toronto.edu/~drorbn/Talks/Chicago-1009/

SetDirectory["C:\\drorbn\\AcademicPensieve\\2011-08\\w-Computations"];
<< "U(I2D)-Program.m"

Diag2T[n_Integer, Diag[hs_, ars___]] := Module[
{base, res},
res = base = T@@Table[{0,0,0,0}, {n}];
hs /. h[i_]^p_. :> (res[[i,1]]=p);
{ars} /. ar[i_,j_] :> (
res=res**(ReplacePart[base, {{i,1}, {j,3}} -> 1] + ReplacePart[base, {{i,2}, {j,4}} -> 1])
);
res
];
Diag2T[n_Integer, expr_] := Expand[expr /. diag_Diag :> Diag2T[n, diag]];

Diag2T[2, {
Diag[h[1],ar[1,2]], Diag[h[1], ar[2,1]], Diag[h[2], ar[1,2]], Diag[h[2], ar[2,1]],
Diag[h[1],ar[2,2]], Diag[h[2],ar[1,1]]
}]

Diag2T[2, +Diag[h[1], ar[2,1]]-Diag[h[2], ar[1,2]] + Diag[h[1],ar[2,2]] - Diag[h[2],ar[1,1]]]

ArrowRules = {
Diag[hs_, lft___, ar[i_,j_], ar[k_,l_], rgt___] /; !OrderedQ[{ar[i,j],ar[k,l]}] :> Plus[
Diag[hs,lft, ar[k,l], ar[i,j], rgt],
Which[
i==k || i==j || k==l, 0,
j==l, Diag[h[i]hs, lft, ar[k,l],rgt]-Diag[h[k]hs, lft, ar[i,j],rgt],
j==k && i==l, (
-Diag[h[i], lft, ar[j,i], rgt]+Diag[h[j], lft, ar[i,j], rgt] - Diag[h[i],lft,ar[j,j],rgt] + Diag[h[j], lft, ar[i,i], rgt]
),
j==k, -Diag[h[i]hs, lft, ar[k,l],rgt]+Diag[h[k]hs, lft, ar[i,l],rgt],
i==l, -Diag[h[i]hs, lft, ar[k,j],rgt]+Diag[h[k]hs, lft, ar[i,j],rgt],
True, 0
]
]
};

Test[n_, diag_] :={
diag,
Diag2T[n, diag],
diag - (diag //. ArrowRules),
Diag2T[n, diag - (diag //. ArrowRules)]
};

Test[3, Diag[1,ar[1,3],ar[1,2]]]

Test[2, Diag[1,ar[2,1],ar[1,2]]]

Test[3, Diag[1, ar[3,1],ar[2,3]]]

Test[3, Diag[1, ar[2,1],ar[1,3]]]

Diag2T[3,12( (1/12) Diag[h[2],ar[1,3]]+(1/12) Diag[h[2],ar[3,1]]-(1/12) Diag[h[3],ar[1,2]]-(1/12) Diag[h[3],ar[2,1]])]

Permutations[Range[3]]

Diag2T[3,Total[
(Signature[#]*PutOn[#,  Diag[h[1],ar[2,3]]- Diag[h[2],ar[1,3]]+ Diag[h[3],ar[1,2]]]/3)& /@ Permutations[Range[3]]
]]